home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue61 / Alfresco / AABufStm.pas next >
Encoding:
Pascal/Delphi Source File  |  2000-08-07  |  13.6 KB  |  401 lines
  1. {*********************************************************}
  2. {* AABUFSTM.PAS                                          *}
  3. {* Copyright (c) Julian M Bucknall 1997, 1999            *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Buffered Stream Class for use with any stream         *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AABufStm;
  14.  
  15. {Notes: The TaaBufferedStream class provides a method to buffer data
  16.         to/from any stream. Since it is a TStream descendant itself,
  17.         it can be used in place of any stream. This makes it easy to
  18.         buffer THandleStream or TFileStream instancves, for example.
  19.         The stream which needs to be buffered is passed as a parameter
  20.         to the Create constructor. The TaaBufferedStream object merely
  21.         provides a buffer between the user and the stream that holds
  22.         the data.
  23.  
  24.         In Delphi 1 and 2, TStream did not provide a SetSize method;
  25.         the Size property was read only. Some descendants of TStream
  26.         did (eg, TMemoryStream), and with the file-based ones writing
  27.         a set size routine is easy. Since TaaBufferedStream will
  28.         sometimes set the size of the underlying stream, it provides
  29.         an event to call to do so. Delphi 3 and later do not require
  30.         this event to be set.}
  31.  
  32.  
  33. interface
  34.  
  35. uses
  36.   SysUtils,
  37.   Classes;
  38.  
  39. {$IFDEF VER100}
  40. {$DEFINE CanSetSize}
  41. {$ENDIF}
  42. {$IFDEF VER120}
  43. {$DEFINE CanSetSize}
  44. {$ENDIF}
  45.  
  46. type
  47.   {$IFDEF Windows}
  48.   TbsMemSize = word;      {Memory size type}
  49.   {$ELSE}
  50.   TbsMemSize = integer;
  51.   {$ENDIF}
  52.  
  53. type
  54.   TaaSetSize = procedure (aStream : TStream; aNewSize : Longint);
  55.     {-procedure prototype for setting the size of a stream}
  56.  
  57. type
  58.   TaaBufferedStream = class(TStream)
  59.     protected {private}
  60.       bsPage      : PByteArray; {buffer}
  61.       bsPageSize  : TbsMemSize; {size of buffer (multiple of 1K)}
  62.       bsPageStart : Longint;    {start of buffer as offset in stream}
  63.       bsPosInPage : TbsMemSize; {current position in buffer}
  64.       bsByteCount : TbsMemSize; {count of valid bytes in buffer}
  65.       bsSize      : Longint;    {count of bytes in stream}
  66.       bsDirty     : boolean;    {whether the buffer is dirty or not}
  67.       bsStream    : TStream;    {actual stream containing data}
  68.       bsSetSize   : TaaSetSize;
  69.     protected
  70.       procedure bsReadBuffer;
  71.       procedure bsWriteBuffer;
  72.  
  73.       procedure SetSize(aNewSize : Longint);
  74.          {$IFDEF CanSetSize} override; {$ENDIF}
  75.         {-set the stream size}
  76.  
  77.     public
  78.       constructor Create(aStream : TStream; aBufSize : TbsMemSize);
  79.         {-create the buffered stream}
  80.       destructor Destroy; override;
  81.         {-destroy the buffered stream}
  82.  
  83.       function Read(var Buffer; Count : Longint) : Longint; override;
  84.         {-read from the stream into a buffer}
  85.       function Write(const Buffer; Count : Longint) : Longint; override;
  86.         {-write to the stream from a buffer}
  87.       function Seek(Offset : Longint; Origin : Word) : Longint; override;
  88.         {-seek to a particular point in the stream}
  89.       procedure Commit;
  90.         {-ensures that all buffered data is flushed to disk}
  91.  
  92.       property OnSetStreamSize : TaaSetSize
  93.          read bsSetSize write bsSetSize;
  94.         {-event to set the size of the stream}
  95.       property Stream : TStream read bsStream;
  96.  
  97.   end;
  98.  
  99. implementation
  100.  
  101. uses
  102.   {$IFDEF Windows}
  103.   WinTypes, WinProcs;
  104.   {$ELSE}
  105.   Windows;
  106.   {$ENDIF}
  107.  
  108. {===Helper routines==================================================}
  109. procedure RaiseException(const S : string);
  110. begin
  111.   raise Exception.Create(S);
  112. end;
  113. {====================================================================}
  114.  
  115.  
  116. {===TaaBufferedStream================================================}
  117. constructor TaaBufferedStream.Create(aStream  : TStream;
  118.                                      aBufSize : TbsMemSize);
  119. var
  120.   ActBufSize : Longint;
  121. begin
  122.   inherited Create;
  123.   {save the actual stream}
  124.   bsStream := aStream;
  125.   {round up the buffer size to a multiple of 1K and a maximum of 32K}
  126.   ActBufSize := (Longint(aBufSize) + 1023) and $FFFFFC00;
  127.   if (ActBufSize > 32 * 1024) then
  128.     bsPageSize := 32 * 1024
  129.   else
  130.     bsPageSize := ActBufSize;
  131.   {create the buffer}
  132.   GetMem(bsPage, bsPageSize);
  133.   {set the page/buffer variables to the start of the stream}
  134.   bsPosInPage := 0;
  135.   bsByteCount := 0;
  136.   bsPageStart := 0;
  137.   bsDirty := false;
  138.   bsSize := aStream.Size;
  139. end;
  140. {--------}
  141. destructor TaaBufferedStream.Destroy;
  142. begin
  143.   {destroy the buffer, after writing it to the actual stream}
  144.   if (bsPage <> nil) then begin
  145.     Commit;
  146.     FreeMem(bsPage, bsPageSize);
  147.   end;
  148.   {let our ancestor clean up}
  149.   inherited Destroy;
  150. end;
  151. {--------}
  152. procedure TaaBufferedStream.bsReadBuffer;
  153. var
  154.   SeekResult : Longint;
  155. begin
  156.   SeekResult := bsStream.Seek(bsPageStart, 0);
  157.   if (SeekResult = -1) then
  158.     RaiseException('TaaBufferedStream.bsReadBuffer: seek failed');
  159.   bsByteCount := bsStream.Read(bsPage^, bsPageSize);
  160.   if (bsByteCount <= 0) then
  161.     RaiseException('TaaBufferedStream.bsReadBuffer: read failed');
  162. end;
  163. {--------}
  164. procedure TaaBufferedStream.bsWriteBuffer;
  165. var
  166.   SeekResult : Longint;
  167.   BytesWrit  : Longint;
  168. begin
  169.   SeekResult := bsStream.Seek(bsPageStart, 0);
  170.   if (SeekResult = -1) then
  171.     RaiseException('TaaBufferedStream.bsWriteBuffer: seek failed');
  172.   BytesWrit := bsStream.Write(bsPage^, bsByteCount);
  173.   if (BytesWrit <> bsByteCount) then
  174.     RaiseException('TaaBufferedStream.bsWriteBuffer: write failed');
  175. end;
  176. {--------}
  177. procedure TaaBufferedStream.Commit;
  178. begin
  179.   if bsDirty then begin
  180.     bsWriteBuffer;
  181.     bsDirty := false;
  182.   end;
  183. end;
  184. {--------}
  185. function TaaBufferedStream.Read(var Buffer; Count : Longint) : Longint;
  186. var
  187.   BufAsBytes  : TByteArray absolute Buffer;
  188.   BufInx      : Longint;
  189.   BytesToGo   : Longint;
  190.   BytesToRead : integer;
  191. begin
  192.   {reading is complicated by the fact we can only read in chunks of
  193.    bsPageSize: we need to partition out the overall read into a
  194.    read from part of the buffer, zero or more reads from complete
  195.    buffers and then a possible read from part of a buffer}
  196.  
  197.   {$IFDEF Windows}
  198.   {in Delphi 1 we do not support reads greater than 65535 bytes}
  199.   if (Count > $FFFF) then
  200.     RaiseException('TaaBufferedStream.Read: requested too many bytes');
  201.   {$ENDIF}
  202.  
  203.   {calculate the actual number of bytes we can read - this depends on
  204.    the current position and size of the stream as well as the number
  205.    of bytes requested}
  206.   BytesToGo := Count;
  207.   if (bsSize < (bsPageStart + bsPosInPage + Count)) then
  208.     BytesToGo := bsSize - (bsPageStart + bsPosInPage);
  209.   if (BytesToGo <= 0) then begin
  210.     Result := 0;
  211.     Exit;
  212.   end;
  213.   {remember to return the result of our calculation}
  214.   Result := BytesToGo;
  215.  
  216.   {initialise the byte index for the caller's buffer}
  217.   BufInx := 0;
  218.   {is there anything in the buffer? if not, go read something from
  219.    the actual stream}
  220.   if (bsByteCount = 0) then
  221.     bsReadBuffer;
  222.   {calculate the number of bytes we can read prior to the loop}
  223.   BytesToRead := bsByteCount - bsPosInPage;
  224.   if (BytesToRead > BytesToGo) then
  225.     BytesToRead := BytesToGo;
  226.   {copy from the stream buffer to the caller's buffer}
  227.   Move(bsPage^[bsPosInPage], BufAsBytes[BufInx], BytesToRead);
  228.   {calculate the number of bytes still to read}
  229.   dec(BytesToGo, BytesToRead);
  230.  
  231.   {while we have bytes to read, read them}
  232.   while (BytesToGo > 0) do begin
  233.     {advance the byte index for the caller's buffer}
  234.     inc(BufInx, BytesToRead);
  235.     {as we've exhausted this buffer-full, advance to the next, check
  236.      to see whether we need to write the buffer out first}
  237.     if bsDirty then begin
  238.       bsWriteBuffer;
  239.       bsDirty := false;
  240.     end;
  241.     inc(bsPageStart, bsPageSize);
  242.     bsPosInPage := 0;
  243.     bsReadBuffer;
  244.     {calculate the number of bytes we can read in this cycle}
  245.     BytesToRead := bsByteCount;
  246.     if (BytesToRead > BytesToGo) then
  247.       BytesToRead := BytesToGo;
  248.     {copy from the stream buffer to the caller's buffer}
  249.     Move(bsPage^, BufAsBytes[BufInx], BytesToRead);
  250.     {calculate the number of bytes still to read}
  251.     dec(BytesToGo, BytesToRead);
  252.   end;
  253.   {remember our new position}
  254.   inc(bsPosInPage, BytesToRead);
  255.   if (bsPosInPage = bsPageSize) then begin
  256.     inc(bsPageStart, bsPageSize);
  257.     bsPosInPage := 0;
  258.     bsByteCount := 0;
  259.   end;
  260. end;
  261. {--------}
  262. function TaaBufferedStream.Seek(Offset : Longint;
  263.                                 Origin : Word) : Longint;
  264. var
  265.   NewPageStart : Longint;
  266.   NewPos       : Longint;
  267. begin
  268.   {calculate the new position}
  269.   case Origin of
  270.     soFromBeginning : NewPos := Offset;
  271.     soFromCurrent   : NewPos := bsPageStart + bsPosInPage + Offset;
  272.     soFromEnd       : NewPos := bsSize + Offset;
  273.   else
  274.     NewPos := 0;
  275.     RaiseException('TaaBufferedStream.Seek: invalid origin');
  276.   end;
  277.   if (NewPos < 0) or (NewPos > bsSize) then
  278.     RaiseException('TaaBufferedStream.Seek: invalid new position');
  279.   {calculate which page of the file we need to be at}
  280.   NewPageStart := NewPos and not(pred(longint(bsPageSize)));
  281.   {if the new page is different than the old, mark the buffer as being
  282.    ready to be replenished, and if need be write out any dirty data}
  283.   if (NewPageStart <> bsPageStart) then begin
  284.     if bsDirty then begin
  285.       bsWriteBuffer;
  286.       bsDirty := false;
  287.     end;
  288.     bsPageStart := NewPageStart;
  289.     bsByteCount := 0;
  290.   end;
  291.   {save the new position}
  292.   bsPosInPage := NewPos - NewPageStart;
  293.   Result := NewPos;
  294. end;
  295. {--------}
  296. procedure TaaBufferedStream.SetSize(aNewSize : Longint);
  297. begin
  298.   {save the new size and alter the position if required}
  299.   bsSize := aNewSize;
  300.   if ((bsPageStart + bsPosInPage) > aNewSize) then
  301.     Seek(0, soFromEnd);
  302.   {now set the size of the actual stream}
  303.   if Assigned(bsSetSize) then
  304.     bsSetSize(bsStream, aNewSize)
  305.   else
  306.     {$IFDEF CanSetSize}
  307.     bsStream.Size := aNewSize;
  308.     {$ELSE}
  309.     RaiseException('TaaBufferedStream.SetSize: cannot set size of underlying stream');
  310.     {$ENDIF}
  311. end;
  312. {--------}
  313. function TaaBufferedStream.Write(const Buffer; Count : Longint) : Longint;
  314. var
  315.   BufAsBytes  : TByteArray absolute Buffer;
  316.   BufInx      : Longint;
  317.   BytesToGo   : Longint;
  318.   BytesToWrite: integer;
  319. begin
  320.   {writing is complicated by the fact we write in chunks of
  321.    bsPageSize: we need to partition out the overall write into a
  322.    write from part of the buffer, zero or more writes from complete
  323.    buffers and then a possible write from part of a buffer}
  324.  
  325.   {$IFDEF Windows}
  326.   {in Delphi 1 we do not support writes greater than 65535 bytes}
  327.   if (Count > $FFFF) then
  328.     RaiseException('TaaBufferedStream.Write: requested too many bytes');
  329.   {$ENDIF}
  330.  
  331.   {when we write to this stream we always assume that we can write the
  332.    requested number of bytes: if we can't (eg, the disk is full) we'll
  333.    get an exception somewhere eventually}
  334.   BytesToGo := Count;
  335.   {remember to return the result of our calculation}
  336.   Result := BytesToGo;
  337.  
  338.   {initialise the byte index for the caller's buffer}
  339.   BufInx := 0;
  340.   {is there anything in the buffer? if not, go try read a block from
  341.    the actual stream - we might be overwriting existing data rather
  342.    than appending data to the end of the stream}
  343.   if (bsByteCount = 0) and (bsSize > bsPageStart) then
  344.     bsReadBuffer;
  345.   {calculate the number of bytes we can write prior to the loop}
  346.   BytesToWrite := bsPageSize - bsPosInPage;
  347.   if (BytesToWrite > BytesToGo) then
  348.     BytesToWrite := BytesToGo;
  349.   {copy from the caller's buffer to the stream buffer}
  350.   Move(BufAsBytes[BufInx], bsPage^[bsPosInPage], BytesToWrite);
  351.   {mark our stream buffer as requiring a save to the actual stream,
  352.    note that this will suffice for the rest of the routine as well: no
  353.    inner routine will turn off the dirty flag}
  354.   bsDirty := true;
  355.   {calculate the number of bytes still to write}
  356.   dec(BytesToGo, BytesToWrite);
  357.  
  358.   {while we have bytes to write, write them}
  359.   while (BytesToGo > 0) do begin
  360.     {advance the byte index for the caller's buffer}
  361.     inc(BufInx, BytesToWrite);
  362.     {as we've filled this buffer, write it out to the actual stream
  363.      and advance to the next buffer, reading it if required}
  364.     bsByteCount := bsPageSize;
  365.     bsWriteBuffer;
  366.     inc(bsPageStart, bsPageSize);
  367.     bsPosInPage := 0;
  368.     bsByteCount := 0;
  369.     if (bsSize > bsPageStart) then
  370.       bsReadBuffer;
  371.     {calculate the number of bytes we can write in this cycle}
  372.     BytesToWrite := bsPageSize;
  373.     if (BytesToWrite > BytesToGo) then
  374.       BytesToWrite := BytesToGo;
  375.     {copy from the caller's buffer to our buffer}
  376.     Move(BufAsBytes[BufInx], bsPage^, BytesToWrite);
  377.     {calculate the number of bytes still to write}
  378.     dec(BytesToGo, BytesToWrite);
  379.   end;
  380.   {remember our new position}
  381.   inc(bsPosInPage, BytesToWrite);
  382.   {make sure the count of valid bytes is correct}
  383.   if (bsByteCount < bsPosInPage) then
  384.     bsByteCount := bsPosInPage;
  385.   {make sure the stream size is correct}
  386.   if (bsSize < (bsPageStart + bsByteCount)) then
  387.     bsSize := bsPageStart + bsByteCount;
  388.   {if we're at the end of the buffer, write it out and advance to the
  389.    start of the next page}
  390.   if (bsPosInPage = bsPageSize) then begin
  391.     bsWriteBuffer;
  392.     bsDirty := false;
  393.     inc(bsPageStart, bsPageSize);
  394.     bsPosInPage := 0;
  395.     bsByteCount := 0;
  396.   end;
  397. end;
  398. {====================================================================}
  399.  
  400. end.
  401.